home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d26
/
lesson.arc
/
LESSON.BAS
next >
Wrap
BASIC Source File
|
1987-10-17
|
23KB
|
1,044 lines
' --------------------------------------------
' LESSON.BAS file last modified on 10/17/87
' by Jeff Thomas
' Box 1029
' Hopatcong High School
' Hopatcong, New Jersey 07843
' --------------------------------------------
TOP:
KEY OFF
ON ERROR GOTO TRAP
OPEN"i",1,"teco.fil"
input#1,lessondays%
INPUT#1,ID$
INPUT#1,C1$
INPUT#1,C2$
INPUT#1,C3$
CLOSE
DIM VL.SS$(12), LO.SS%(12,2)
DIM LE.SS%(12), TY.SS$(12)
DIM PIC.SS$(12),RG.SS(12,2)
DIM CL.SS%(12,2), SPECCHR.SS%(12)
DIM A$(12),B$(12)
DIM C$(30,12),T$(15)
DIM DA$(5)
SD.SS%=1
NUMSCR.SS%=1
BLNK.SS$=SPACE$(78)
DEF SEG=&H40:MONO.SS=(PEEK(&H10) AND &H30)=&H30
IF MONO.SS THEN
SCRNSEG.SS%=&HB000
ELSE
SCRNSEG.SS%=&HB800
END IF
WIDTH"lpt1:",150
OPEN"r",1,"lesson.fil",480
FIELD 1,40 AS B$(1),40 AS B$(2),40 AS B$(3),_
40 AS B$(4),40 AS B$(5),40 AS B$(6),_
40 AS B$(7),40 AS B$(8),40 AS B$(9),_
40 AS B$(10),40 AS B$(11),40 AS B$(12)
MENU:
CLS
call drawit(3,0,2,20,18,56)
COLOR 3,0
LOCATE 4,32
? "LESSON PLANS"
LOCATE 6,25
? "V 2 by Jeff Thomas 10/11/87"
LOCATE 8,34
? "Create"
LOCATE 10,34
? "Enter"
LOCATE 12,34
? "Print"
LOCATE 14,34
? "Modify"
LOCATE 16,34
? "Help Quit"
COLOR 14,0
LOCATE 8,34 : ?"C";
LOCATE 10,34 : ?"E";
LOCATE 12,34 : ?"P";
LOCATE 14,34 : ?"M";
LOCATE 16,34 : ?"H";
LOCATE 16,41 : ?"Q";
ROW=8
CH=1
COLOR 15,0
ARROW:
LOCATE ROW,28
PRINT"==> ";
INLOOP1:
CH$=INKEY$ : IF CH$ = "" THEN INLOOP1
IF LEN(CH$) = 1 THEN
CH$=UCASE$(CH$)
IF CH$=CHR$(13) THEN ENTER
IF CH$ = "C" THEN
LOCATE ROW,28
?" ";
LOCATE 8,28
?"==> ";
GOTO CREATELESSONFILE
END IF
IF CH$ = "E" THEN
LOCATE ROW,28
?" ";
LOCATE 10,28
?"==> ";
GOTO ENTERLESSONS
END IF
IF CH$ = "P" THEN
LOCATE ROW,28
?" ";
LOCATE 12,28
?"==> ";
GOTO PRINTLESSONS
END IF
IF CH$ = "M" THEN
LOCATE ROW,28
?" ";
LOCATE 14,28
?"==> ";
GOTO EDITLESSONS
END IF
IF CH$ = "H" THEN
LOCATE ROW,28
?" ";
LOCATE 16,28
?"==> ";
GOTO HELP
END IF
IF CH$ = "Q" THEN
LOCATE ROW,28
?" ";
LOCATE 16,28
?"==> ";
GOTO QUIT
END IF
BEEP
GOTO INLOOP1
END IF
IF RIGHT$(CH$,1)="P" THEN
LOCATE ROW,28
PRINT" ";
ROW=ROW+2
CH=CH+1
IF CH>5 THEN
CH=1
ROW=8
END IF
GOTO ARROW
END IF
IF RIGHT$(CH$,1)="H" THEN
LOCATE ROW,28
PRINT" ";
ROW=ROW-2
CH=CH-1
IF CH<1 THEN
CH=5
ROW=16
END IF
GOTO ARROW
END IF
GOTO INLOOP1
ENTER:
ON CH GOTO CREATELESSONFILE,ENTERLESSONS,PRINTLESSONS,EDITLESSONS,HELP
QUIT:
COLOR 14,0
CLOSE
LOCATE 20,1
? STRING$(79,32)
LOCATE 20,15
PRINT"Have a good week...Hope your lessons go well!"
LOCATE 22,1
END
ENTERLESSONS:
COLOR 14,0
LOCATE 20,1
PRINT STRING$(79,32);
LOCATE 20,1,1,0,7
PRINT"What lesson day are you working on ( 1 -"lessondays%") ";
INPUT LD
IF LD <1 OR LD > lessondays% THEN
BEEP
GOTO ENTERLESSONS
END IF
REC = LD * 3 - 3 + 1
FOR J = 1 TO 3
FOR I=1 TO 12
A$(I) = ""
NEXT
GET 1,REC
FOR I = 1 TO 12
A$(I) = B$(I)
NEXT
SCR.SS% = 1
INIT.SS% = -1
GOSUB FULLSCREENEDIT
FOR I = 1 TO 12
LSET B$(I) = A$(I)
PUT 1,REC
NEXT I
REC = REC + 1
NEXT J
CLOSE
RUN
PRINTLESSONS:
TRYAGAIN:
CLS
LOCATE 3,1
COLOR 3,0
CLS
FOR I=1 TO 12
A$(I) = ""
NEXT
OPEN"I",2,"WEEK.FIL"
INPUT#2,A$(1)
INPUT#2,A$(2)
FOR I=1 TO VAL(A$(2))
INPUT#2,A$(I+2)
NEXT
CLOSE#2
SCR.SS% = 1
INIT.SS% = -1
DIFSCRN = 1
GOSUB FULLSCREENEDIT
DIFSCRN = 0
OPEN"O",2,"WEEK.FIL"
X = INSTR(A$(1)," ")
DA$ = LEFT$(A$(1),X-1)
PRINT#2,CHR$(34)DA$CHR$(34)
NUMBEROFDAYS = VAL(A$(2))
PRINT#2,NUMBEROFDAYS
FOR I=1 TO NUMBEROFDAYS
X = INSTR(A$(I+2)," ")
DA$(I) = LEFT$(A$(I+2),X-1)
PRINT#2,CHR$(34)DA$(I)CHR$(34)
NEXT
CLOSE#2
D=1
FOR I=1 TO NUMBEROFDAYS * 3 STEP 3
T$(I) = C1$+" "+DA$(D)
T$(I+1) = C2$+" "+DA$(D)
T$(I+2) = C3$+" "+DA$(D)
D=D+1
NEXT
HD$ = id$ + "--> DATES INCLUSIVE " + DA$
LOCATE 25,1
? STRING$(79,32);
LOCATE 18,1
? STRING$(79,32);
LOCATE 18,1,1,0,7
COLOR 3,0
PRINT"What lesson day do you want to start with ( 1 -"lessondays%") ";
INPUT START
IF START < 1 OR START > lessondays% THEN
BEEP
GOTO PRINTLESSONS
END IF
FINISH = NUMBEROFDAYS
INLOOP2:
LOCATE 18,1
? STRING$(79,32);
LOCATE 18,1
PRINT"Which condensed font control code"
?" <1> CHR$(15) for an IBM printer"
?" <2> CHR$(27)CHR$(20) for a Tandy printer"
?" <3> None (15 inch paper) ";
GETTYPE:
type$ = input$(1)
select case type$
case "1"
LPRINT CHR$(15);
GOTO GOODINPUT
case "2"
LPRINT CHR$(27)CHR$(20);
GOTO GOODINPUT
case "3"
goto GOODINPUT
CASE ELSE
GOTO GETTYPE
end select
GOODINPUT:
LOCATE 18,1,0,0,0
? STRING$(79,32);
LOCATE 19,1
? STRING$(79,32);
LOCATE 20,1
? STRING$(79,32);
LOCATE 21,1
? STRING$(79,32);
LOCATE 18,1
PRINT"Now printing...press ESC to abort...";
NUMREC = FINISH * 3
START = START * 3 - 2
ENTRYCOUNT = 0
ROW = 7
COL = 20
MAX = 45
COUNT = 1
DAY = 1
FOR REC = START TO NUMREC + START -1
IF COUNT = 4 OR COUNT=7 OR COUNT=10 OR COUNT=13 THEN DAY=DAY+1
X = LEN(T$(COUNT))
ADD =MAX - X
T$(COUNT) =T$(COUNT) + STRING$(ADD,"-")
COUNT = COUNT + 1
NEXT REC
COUNT=1
FOR REC = START TO NUMREC + START - 1
GET 1,REC
FOR ROW=1 TO 12
C$(COUNT,ROW) = B$(ROW)
NEXT ROW
COUNT = COUNT+1
NEXT REC
LPRINT HD$
COUNT = 1
FOR REC = START TO NUMREC + START - 1 STEP 3
AK$=INKEY$:IF AK$=CHR$(27) THEN QUITPRINTING:
LPRINT T$(COUNT) T$(COUNT+1) T$(COUNT+2)
AK$=INKEY$:IF AK$=CHR$(27) THEN QUITPRINTING:
FOR ROW=1 TO 12
AK$=INKEY$:IF AK$=CHR$(27) THEN QUITPRINTING:
LPRINT C$(COUNT,ROW)TAB(45)C$(COUNT+1,ROW)_
TAB(90)C$(COUNT+2,ROW)
AK$=INKEY$:IF AK$=CHR$(27) THEN QUITPRINTING:
NEXT ROW
COUNT=COUNT+3
AK$=INKEY$:IF AK$=CHR$(27) THEN QUITPRINTING:
NEXT REC
QUITPRINTING:
CLOSE
RUN
EDITLESSONS:
COLOR 14,0
LOCATE 20,1
? STRING$(78,32);
LOCATE 20,1,1,0,7
PRINT"What lesson day to modify ( 1 -"lessondays%") ";
INPUT LD
IF LD < 1 OR ld > lessondays% THEN
BEEP
GOTO EDITLESSONS
END IF
REC = LD * 3 - 3 + 1
LOCATE 20,1,0,0,0
? STRING$(78,32);
LOCATE 20,30
? "What course ?"
? TAB(30)"1. "C1$
? TAB(30)"2. "C2$
? TAB(30)"3. "C3$" ";
INLOOP3:
WC$ = INKEY$
IF WC$="" THEN INLOOP3
J = VAL(WC$)
IF J < 1 OR J > 3 THEN BEEP:GOTO INLOOP3
? J;
REC = REC + J - 1
GET 1,REC
FOR I = 1 TO 12
A$(I) = B$(I)
NEXT
SCR.SS% = 1
INIT.SS% = -1
GOSUB FULLSCREENEDIT
FOR I = 1 TO 12
LSET B$(I)=A$(I)
NEXT
PUT 1,REC
CLOSE
RUN
FULLSCREENEDIT:
IF SAME.SS% THEN RETURNTOSAMESCREEN
IF DIFSCRN = 0 THEN NUMFLDS.SS% = 12
IF DIFSCRN = 1 THEN NUMFLDS.SS% = 7
FILNM.SS$ = "PLANS.SCR"
EXITCHR.SS$ = CHR$(27) + CHR$(127) + ""
FOR F.SS% = 1 TO NUMFLDS.SS%
LO.SS%(F.SS%,2) = 23
LO.SS%(F.SS%,1) = f.ss%+8
LE.SS%(F.SS%) = 40
TY.SS$(F.SS%) = "C"
PIC.SS$(F.SS%) = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
RG.SS(F.SS%,1) = 0
RG.SS(F.SS%,2) = 0
CL.SS%(F.SS%,1) = 11
CL.SS%(F.SS%,2) = 0
SPECCHR.SS%(F.SS%) = 0
NEXT F.SS%
OUT &H3D8,&H1
DEF SEG=SCRNSEG.SS%
BLOAD FILNM.SS$,0
DEF SEG
FOR I=1 TO 12
VL.SS$(I) = A$(I)
NEXT
OUT &H3D8,&H29
GOSUB SETUPSCREEN
OUT &H3D8,&H29
F.SS%=1
SCRLST.SS%=SCR.SS%
RETURNTOSAMESCREEN:
COLOR 7,0:LOCATE 25,1:PRINT BLNK.SS$;
IF NUMFLDS.SS%=0 THEN RETURN
EXSCR.SS%=0
COL=38-LEN(ID$)/2
COLOR 11,0
LOCATE 5,COL
PRINT ID$
IF DIFSCRN = 0 THEN
LOCATE 7,15
PRINT"Lesson for day #"LD" --> ";
IF J = 1 THEN T$ = C1$
IF J = 2 THEN T$ = C2$
IF J = 3 THEN T$ = C3$
PRINT T$
END IF
IF DIFSCRN = 1 THEN
ROW = 16
FOR I=1 TO 5
LOCATE ROW,16,0,0,0 : ?" ";
ROW = ROW + 1
NEXT
LOCATE 18,14
? "Please modify your WEEK.fil"
LOCATE 9,1
? " Inclusive";
LOCATE 10,1
? " # of days";
LOCATE 11,1
? "1st Day/date"
? "2nd Day/date"
? "3rd Day/date"
? "4th Day/date"
? "5th Day/date"
END IF
INPUTSCREENDATA:
WHILE NOT EXSCR.SS%
locate 11,20,1,0,7
GOSUB ACCEPTINPUTDATA
WEND
COLOR 7,0
LOCATE 25,1,0,0,0
PRINT BLNK.SS$;
LOCATE 25,15,0,0,0
? "... Please WAIT A Moment While Checking Fields ...";
FOR F.SS%=1 TO NUMFLDS.SS%
IF ERR.MSG%=-1 THEN
EXSCR.SS%=0
GOTO INPUTSCREENDATA
END IF
NEXT F.SS%
F.SS%=FLDLST.SS%
FOR I=1 TO 12
A$(I) = VL.SS$(I)
NEXT
RETURN
SETUPSCREEN:
FOR F.SS%=1 TO NUMFLDS.SS%
IF LEN(VL.SS$(F.SS%))>LE.SS%(F.SS%) THEN
VL.SS$(F.SS%)=LEFT$(VL.SS$(F.SS%),LE.SS%(F.SS%))
END IF
IF LEN(VL.SS$(F.SS%))<=LE.SS%(F.SS%) THEN
VL.SS$(F.SS%)=VL.SS$(F.SS%)+MID$(BLNK.SS$,1,LE.SS%(F.SS%)-_
LEN(VL.SS$(F.SS%)))
END IF
GOSUB PRINTNEWVALUEOFFIELD
NEXT F.SS%
RETURN
ACCEPTINPUTDATA:
IF TY.SS$(F.SS%)<>"N" THEN
A.SS%=1
GOTO LOOKFORNONEDITCHARACTERS
END IF
NEWNUM%=-1
SIGN.ON%=0
NUMED.SS%=0
DECPOS%=INSTR(PIC.SS$(F.SS%),".")
IF DECPOS%=0 THEN DECPOS%=LE.SS%(F.SS%)+1
A.SS%=DECPOS%-1
LOOKFORNONEDITCHARACTERS:
WHILE INSTR("ULX#98.",MID$(PIC.SS$(F.SS%),A.SS%,1))=0
A.SS%=A.SS%+1
WEND
CURCOL%=LO.SS%(F.SS%,2)+A.SS%-1
LOCATE LO.SS%(F.SS%,1),CURCOL%
FLDLST.SS% = F.SS%
EXFLD.SS%=0
WHILE NOT EXFLD.SS%
INLOOP5:
X.SS$=INKEY$
IF X.SS$="" THEN INLOOP5
IF ERR.MSG% THEN
ERR.MSG%=0
COLOR 7,0
LOCATE 25,1
PRINT STRING$(79," ");
END IF
IF LEN(X.SS$)>1 OR INSTR(CHR$(8)+CHR$(13)+CHR$(27),X.SS$)<>0 THEN
X.SS$=RIGHT$(X.SS$,1)
ELSE
GOTO EXTENDEDKEY
END IF
IF TY.SS$(F.SS%)<>"N" THEN SPECIALTEST
IF INSTR("GO",X.SS$)<>0 THEN CODESNOTVALID
IF INSTR("RKM"+CHR$(8),X.SS$)<>0 THEN NUMED.SS%=-1:NEWNUM%=0
SPECIALTEST:
IF INSTR(EXITCHR.SS$,X.SS$)<>0 THEN
EXFLD.SS%=-1
EXSCR.SS%=-1
GOTO EXITSCREEN
END IF
ON INSTR("MKHPGRSO"+CHR$(8)+CHR$(13),X.SS$)_
GOSUB RIGHT,LEFT,UP,DOWN,HOME,INS,DEL,ENDKEY,LEFT,DOWN:_
GOTO CHECKFORERROR
GOTO CODESNOTVALID
EXTENDEDKEY:
IF TY.SS$(F.SS%)="N" AND X.SS$="." THEN
NEWNUM%=0
NUMED.SS%=-1
GOTO NEXTPOSITION
END IF
IF ASC(X.SS$)<32 OR ASC(X.SS$)>126 THEN GOTO CODESNOTVALID
GOSUB TYPECONVERSION
IF ERR.MSG% THEN CODESNOTVALID
GOSUB ADDCHARACTERS
GOSUB PRINTNEWVALUEOFFIELD
NEXTPOSITION:
GOSUB NEWLOCATION
CHECKFORERROR:
IF ERR.MSG% THEN ACCEPTINPUTDATA
CODESNOTVALID:
WEND
EXITSCREEN:
LASTCHR.SS$=X.SS$
RETURN
RIGHT:
GOSUB NEWLOCATION
RETURN
LEFT:
IF CURCOL%=LO.SS%(F.SS%,2) THEN GOTO UP
IF TY.SS$(F.SS%)="N" AND MID$(VL.SS$(F.SS%),A.SS%-1,1)=" " THEN RETURN
CURCOL%=CURCOL%-1
A.SS%=A.SS%-1
IF INSTR("ULX#89",MID$(PIC.SS$(F.SS%),A.SS%,1))=0 THEN GOTO LEFT
LOCATE LO.SS%(F.SS%,1),CURCOL%
RETURN
UP:
IF ERR.MSG% THEN RETURN
EXFLD.SS%=-1
IF F.SS%>1 THEN
F.SS%=F.SS%-1
ELSE
F.SS%=NUMFLDS.SS%
END IF
RETURN
DOWN:
IF ERR.MSG% THEN RETURN
EXFLD.SS%=-1
IF F.SS%=NUMFLDS.SS% AND INSTR(EXITCHR.SS$,CHR$(127))<>0 THEN EXSCR.SS%=-1
IF F.SS%<NUMFLDS.SS% THEN
F.SS%=F.SS%+1
ELSE
F.SS%=1
END IF
RETURN
DEL:
IF TY.SS$(F.SS%)="N" AND A.SS%<DECPOS% THEN
MID$(VL.SS$(F.SS%),1)=" "+LEFT$(VL.SS$(F.SS%),A.SS%-1)+_
RIGHT$(VL.SS$(F.SS%),LE.SS%(F.SS%)-A.SS%)
GOTO MOVELEFT
END IF
IF TY.SS$(F.SS%)="N" THEN
MID$(VL.SS$(F.SS%),1)=LEFT$(VL.SS$(F.SS%),A.SS%-1)+_
MID$(VL.SS$(F.SS%),A.SS%+1,LE.SS%(F.SS%)-A.SS%)+"0"
GOTO MOVELEFT
END IF
IF SPECCHR.SS%(F.SS%)=0 THEN
MID$(VL.SS$(F.SS%),1)=LEFT$(VL.SS$(F.SS%),A.SS%-1)+_
MID$(VL.SS$(F.SS%),A.SS%+1,LE.SS%(F.SS%)-A.SS%)+" "
GOTO MOVELEFT
END IF
CNT.SS%=0
WHILE INSTR("ULX#89.",MID$(PIC.SS$(F.SS%),A.SS%+1+CNT.SS%,1))<>0 AND_
CNT.SS%<LE.SS%(F.SS%)-A.SS%
CNT.SS%=CNT.SS%+1
WEND
VL.SS$(F.SS%)=LEFT$(VL.SS$(F.SS%),A.SS%-1)+_
MID$(VL.SS$(F.SS%),A.SS%+1,CNT.SS%)+" "+_
RIGHT$(VL.SS$(F.SS%),LE.SS%(F.SS%)-A.SS%-CNT.SS%)
MOVELEFT:
CURCOL%=CURCOL%-1
A.SS%=A.SS%-1
GOSUB PRINTNEWVALUEOFFIELD
GOSUB NEWLOCATION
RETURN
INS:
IF TY.SS$(F.SS%)="N" AND A.SS%<DECPOS% THEN
MID$(VL.SS$(F.SS%),1)=MID$(VL.SS$(F.SS%),2,A.SS%-1)+_
"0"+RIGHT$(VL.SS$(F.SS%),LE.SS%(F.SS%)-A.SS%)
GOTO MOVE
END IF
IF TY.SS$(F.SS%)="N" THEN
VL.SS$(F.SS%)=LEFT$(VL.SS$(F.SS%),A.SS%-1)+"0"+_
MID$(VL.SS$(F.SS%),A.SS%,LE.SS%(F.SS%)-A.SS%)
GOTO MOVE
END IF
IF SPECCHR.SS%(F.SS%)=0 THEN
VL.SS$(F.SS%)=LEFT$(VL.SS$(F.SS%),A.SS%-1)+" "+_
MID$(VL.SS$(F.SS%),A.SS%,LE.SS%(F.SS%)-A.SS%)
GOTO MOVE
END IF
NEWVL$=LEFT$(VL.SS$(F.SS%),A.SS%-1)+" "
NEXTCHR$=MID$(VL.SS$(F.SS%),A.SS%,1)
FOR I%=A.SS%+1 TO LE.SS%(F.SS%)
X.SS$=MID$(PIC.SS$(F.SS%),I%,1)
IF INSTR("ULX#89.",X.SS$)=0 THEN
NEWVL$=NEWVL$+X.SS$
GOTO BREAKOUT
END IF
NEWVL$=NEWVL$+NEXTCHR$
NEXTCHR$=MID$(VL.SS$(F.SS%),I%,1)
NEXT I%
BREAKOUT:
VL.SS$(F.SS%)=NEWVL$+MID$(VL.SS$(F.SS%),I%+1,LE.SS%(F.SS%))
MOVE:
CURCOL%=CURCOL%-1:A.SS%=A.SS%-1
GOSUB PRINTNEWVALUEOFFIELD
GOSUB NEWLOCATION
RETURN
ENDKEY:
CURCOL%=LO.SS%(F.SS%,2)+LE.SS%(F.SS%)-1
A.SS%=LE.SS%(F.SS%)
WHILE INSTR("ULX#89.",MID$(PIC.SS$(F.SS%),A.SS%,1))=0
A.SS%=A.SS%-1
CURCOL%=CURCOL%-1
WEND
LOCATE LO.SS%(F.SS%,1),CURCOL%
RETURN
HOME:
A.SS%=1
WHILE INSTR("ULX#89.",MID$(PIC.SS$(F.SS%),A.SS%,1))=0
A.SS%=A.SS%+1
WEND
CURCOL%=LO.SS%(F.SS%,2)+A.SS%-1
LOCATE LO.SS%(F.SS%,1),CURCOL%
RETURN
TYPECONVERSION:
ON INSTR("NDMY",TY.SS$(F.SS%)) GOTO NUMERIC,NUMERICSPACE,MF,YN
ON INSTR("ULX#89",MID$(PIC.SS$(F.SS%),A.SS%,1))_
GOTO UC,LC,GETOUT,NUMERIC,NUMERICONLY,NUMERICSPACE
PRINT "EDIT PICTURE TYPE ";MID$(PIC.SS$(F.SS%),A.SS%,1);" NOT FOUND"
STOP
NUMERIC:
IF (ASC(X.SS$)>47 AND ASC(X.SS$)<58) OR X.SS$=" " THEN
SIGN.ON%=-1
RETURN
END IF
IF X.SS$<>"+" AND X.SS$<>"-" THEN ONLYMESSAGE
IF SIGN.ON% THEN
MSG.SS$=""
GOSUB PRINTERRORMESSAGE
ELSE
SIGN.ON%=-1
END IF
RETURN
ONLYMESSAGE:
MSG.SS$=" Only numeric values can be entered here. Please re-enter. "
GOSUB PRINTERRORMESSAGE
RETURN
UC:
IF ASC(X.SS$)>96 AND ASC(X.SS$)<123 THEN X.SS$=CHR$(ASC(X.SS$)-32)
GOTO GETOUT
LC:
IF ASC(X.SS$)>65 AND ASC(X.SS$)<91 THEN X.SS$=CHR$(ASC(X.SS$)+32)
GOTO GETOUT
YN:
IF X.SS$="Y" OR X.SS$="y" THEN
X.SS$="Y"
GOTO GETOUT
END IF
IF X.SS$="N" OR X.SS$="n" THEN
X.SS$="N"
GOTO GETOUT
END IF
MSG.SS$=" Only 'Y' or 'N' can be entered here. Please re-enter. "
GOTO PRINTERRORMESSAGE
MF:
IF X.SS$="M" OR X.SS$="m" THEN
X.SS$="M"
GOTO GETOUT
END IF
IF X.SS$="F" OR X.SS$="f" THEN
X.SS$="F"
GOTO GETOUT
END IF
MSG.SS$=" Only 'M' or 'F' can be entered here. Please re-enter. "
GOTO PRINTERRORMESSAGE
NUMERICONLY:
IF (ASC(X.SS$)>47 AND ASC(X.SS$)<58) THEN GETOUT
MSG.SS$=" Only numeric values can be entered here. Please re-enter. "
GOTO PRINTERRORMESSAGE
NUMERICSPACE:
IF (ASC(X.SS$)>47 AND ASC(X.SS$)<58) OR X.SS$=" " THEN GOTO GETOUT
MSG.SS$=" Only numeric values or blanks can be entered here. Please re-enter. "
GOTO PRINTERRORMESSAGE
GETOUT:
3460 RETURN
PRINTERRORMESSAGE:
ERR.MSG%=-1
SOUND 500,SD.SS%*1:LOCATE 25,INT(81-LEN(MSG.SS$))/2
COLOR 0,7
PRINT MSG.SS$;
LOCATE LO.SS%(F.SS%,1),CURCOL%
WHILE INKEY$<>""
WEND
RETURN
ADDCHARACTERS:
IF TY.SS$(F.SS%)="N" AND NEWNUM% THEN
MID$(VL.SS$(F.SS%),1)=MID$(BLNK.SS$,1,A.SS%-1)+X.SS$+_
"."+STRING$(LE.SS%(F.SS%),"0")
NEWNUM%=0
RETURN
END IF
AGAIN:
IF TY.SS$(F.SS%)<>"N" OR NUMED.SS%=-1 THEN
MID$(VL.SS$(F.SS%),A.SS%,1)=X.SS$
RETURN
END IF
IF LEFT$(VL.SS$(F.SS%),1)=" " THEN
MID$(VL.SS$(F.SS%),1,A.SS%)=MID$(VL.SS$(F.SS%),2,A.SS%-1)+X.SS$
ELSE
NUMED.SS%=-1
GOTO AGAIN
END IF
RETURN
PRINTNEWVALUEOFFIELD:
COLOR CL.SS%(F.SS%,1),CL.SS%(F.SS%,2)
LOCATE LO.SS%(F.SS%,1),LO.SS%(F.SS%,2)
PRINT VL.SS$(F.SS%);
RETURN
NEWLOCATION:
IF TY.SS$(F.SS%)<>"N" OR NUMED.SS%<>0 THEN NUMERICTYPE
IF LEFT$(VL.SS$(F.SS%),1)<>" " THEN
NUMED.SS%=-1
ELSE
A.SS%=DECPOS%-1
CURCOL%=LO.SS%(F.SS%,2)+A.SS%-1
LOCATE LO.SS%(F.SS%,1),CURCOL%
RETURN
END IF
NUMERICTYPE:
IF A.SS%<LE.SS%(F.SS%) THEN
A.SS%=A.SS%+1
CURCOL%=CURCOL%+1
ELSE
GOSUB DOWN
RETURN
END IF
IF INSTR("ULX#89",MID$(PIC.SS$(F.SS%),A.SS%,1))=0 THEN NUMERICTYPE
LOCATE LO.SS%(F.SS%,1),CURCOL%
RETURN
CREATELESSONFILE:
TOP1:
KEY OFF
COLOR 14,0
CLS
START=2
LOCATE START,1
PRINT"LESSON PLAN CREATE MODULE"
COLOR 3,0
LOCATE START+2,1
PRINT"This program will create a new LESSON PLAN file"
PRINT"and will overwrite any existing file.
LOCATE START+4,1
PRINT"Are you sure you want to continue? (YES/NO) ";
INPUT C$
C$ = UCASE$(C$)
IF C$="YES" THEN OKTOCONTINUE
IF C$="NO" THEN BAILOUT
BEEP
GOTO TOP1
OKTOCONTINUE:
LOCATE START+6,1
PRINT"How many records (school days) will you need ";
COLOR 4,0
PRINT"(180) ";
COLOR 3,0
INPUT SD
IF SD=0 THEN
SD=180
LOCATE START+6,52
PRINT SD
END IF
LOCATE START+8,1
PRINT"You will need"SD*3*40*12"bytes of disk space for lesson.fil."
LOCATE START+10,1
PRINT"If this is a problem, press [ESC] or any other key to continue.";
INLOOP:
C$=INKEY$
IF C$="" THEN INLOOP
IF C$=CHR$(27) THEN
LOCATE START+12,1
COLOR 4,0
PRINT"ROUTINE ABORTED!"
COLOR 3,0
GOTO BAILOUT
END IF
LOCATE START+12,1
PRINT"Now creating file...please wait."
OPEN"r",1,"lesson.fil",480
FIELD 1,480 AS B$
for i=1 to 12
a$(i)=STRING$(40," ")
next
a$(1)="OBJTVS: "
A$(5)="MTHDS: "
A$(10)="HMWK: "
FOR I=1 TO 12
A$=A$+A$(I)
NEXT
FOR I=1 TO SD*3
LSET B$ = A$
PUT 1,I
IF I/3=INT(I/3) THEN
R=R+1
LOCATE START+14,1
PRINT"Finished with record";
COLOR 14,0
PRINT R;
COLOR 3,0
END IF
NEXT I
CLOSE
cls
color 14,0
locate 5,30
? "Course Information"
ph$="Name/School/Room(s)"
CALL USERINPUT(ph$,7,30,40,3,0,3,0,3,0,254,177," ",3)
a$(1)=sysalpha$
for i% = 2 to 4
color 14,0
ph$="Course Info for Prep "+str$(i%-1)+":"
CALL USERINPUT(ph$,8+i%,40,25,3,0,3,0,3,0,254,177," ",3)
if sysalpha$ ="" then sysalpha$ = "None"
a$(i%) = sysalpha$
next
open"o",1,"teco.fil"
print#1,sd
for i% = 1 to 4
print#1,chr$(34)a$(i%)chr$(34)
next
close
BAILOUT:
close
RUN
HELP:
CLS
COLOR 12,0
?"LESSON PLAN HELP SCREEN"
COLOR 3,0
?"I. STEP 1"
?" A. Select Create"
?" 1. This will set up your files."
?" 2. Only use this the first day you use LESSON PLANS."
?"II. STEP 2"
?" A. Select Enter"
?" 1. Keep a calandar with the number of the lesson day marked on it."
?" 2. You may enter THREE preparations maximum for each lesson day."
?" 3. Full screen editing is supported. Press ESC when finished with"
?" a prep. The next prep will appear for that lesson day."
?"III. STEP 3"
?" A. Select Print"
?" 1. Fill-in the required information for the week.fil"
?" a. inclusive - range of dates (max is 5)"
?" b. # of days - max is 5"
?" c. days and dates - max is 5"
?" 2. Press ESC or RETURN on the last day/date line"
?" 3. Input which lesson day to start with."
?" 4. Input which condensed font control code (IBM, Tandy, None)"
?" 5. Printing will start...You may press ESC to abort printing."
?"IV. STEP 4"
?" A. Select Quit"
COLOR 12,0
?"Press any key to return to menu";
ak$ = input$(1)
close
run
SUB USERINPUT (prompt$,row%,col%,fldsiz%,fldfg%,fldbg%,cursfg%,cursbg%,chrfg%,chrbg%,fldchr%,curchr%,filchr$,systyp%)
SHARED SYSNUM,SYSALPHA$
SYSALPHA$=""
LOCATE ROW%,COL%-LEN(PROMPT$)-1
? PROMPT$
LOCATE ROW%,COL%
FOR X=1 TO FLDSIZ%
COLOR FLDFG%,FLDBG%
PRINT CHR$(FLDCHR%);
NEXT X
MAINLOOP:
IF FLDSIZ% = LEN(SYSALPHA$) THEN LOOKFORAKEY
LOCATE ROW%,COL%
COLOR CURSFG%,CURSBG%
PRINT CHR$(CURCHR%);
LOCATE ROW%,COL%
LOOKFORAKEY:
STROKE$ = INKEY$
IF LEN(SYSALPHA$) <> FLDSIZ% THEN LESSTHANFIELDSIZE
LOCATE ROW%,COL%-1
COLOR CHRFG%,CHRBG%
PRINT RIGHT$(SYSALPHA$,1);
delay .1
LOCATE ROW%,COL%-1
COLOR CURSFG%,CURSBG%
PRINT CHR$(CURCHR%);
delay .1
LESSTHANFIELDSIZE:
IF STROKE$ = "" THEN LOOKFORAKEY
IF STROKE$ = CHR$(13) THEN USERISFINISHED
IF STROKE$ = CHR$(8) AND LEN(SYSALPHA$) = 0 THEN LOOKFORAKEY
IF STROKE$ = CHR$(8) AND LEN(SYSALPHA$) = FLDSIZ% THEN LOCATE ROW%,COL%-1
IF STROKE$ = CHR$(8) THEN
COLOR FLDFG%,FLDBG%
PRINT CHR$(FLDCHR%);
COL% = COL% - 1
SYSALPHA$ = LEFT$(SYSALPHA$,LEN(SYSALPHA$)-1)
GOTO MAINLOOP
end if
IF SYSTYP% = 1 OR SYSTYP% = 3 THEN ALPHANUMERICFIELD
IF SYSTYP% = 2 THEN NUMERICFIELD
SYSTYP% = 1
ALPHANUMERICFIELD:
IF STROKE$ < CHR$(32) OR STROKE$ > CHR$(126) THEN
GOTO LOOKFORAKEY
ELSE
GOTO ADDKEY
end if
NUMERICFIELD:
IF STROKE$ < CHR$(48) OR STROKE$ > CHR$(57) THEN
GOTO LOOKFORAKEY
ELSE
GOTO ADDKEY
end if
ADDKEY:
IF FLDSIZ% = LEN(SYSALPHA$) THEN LOOKFORAKEY
SYSALPHA$ = SYSALPHA$ + STROKE$
COLOR CHRFG%,CHRBG%
PRINT STROKE$;
COL% = COL% + 1
GOTO MAINLOOP
USERISFINISHED:
IF LEN(SYSALPHA$) <> FLDSIZ% THEN
LOCATE ROW%,COL%
COLOR FLDFG%,FLDBG%
PRINT CHR$(FLDCHR%);
GOTO WHICHFILL
end if
LOCATE ROW%,COL%-1
COLOR CHRFG%,CHRBG%
PRINT RIGHT$(SYSALPHA$,1);
WHICHFILL:
IF SYSTYP% = 1 THEN ALPHARIGHT
IF SYSTYP% = 2 THEN NUMBERS
IF SYSTYP% = 3 THEN ALPHALEFT
SYSTYP% = 3
GOTO ALPHALEFT
ALPHARIGHT:
FOR X = 1 TO FLDSIZ%
SYSFIL$ = SYSFIL$ + FILCHR$
NEXT X
SYSFIL$ = RIGHT$(SYSFIL$,FLDSIZ%)
SYSALPHA$ = SYSFIL$ + SYSALPHA$
SYSALPHA$ = RIGHT$(SYSALPHA$,FLDSIZ%)
ALPHALEFT:
FOR X = 1 TO FLDSIZ%
SYSFIL$ = SYSFIL$ + FILCHR$
NEXT X
NUMBERS:
IF SYSTYP% = 2 THEN SYSNUM = VAL(SYSALPHA$)
END SUB
SUB DRAWIT(Fg,Bg,UlRow,UlCol,LrRow,LrCol)
if LrRow < UlRow then swap LrRow,UlRow
if UlRow < 1 then UlRow = 1
if UlRow > 24 then UlRow = 24
if LrRow < 1 then LrRow = 1
if LrRow > 24 then LrRow = 24
if LrCol < UlCol then swap LrCol,UlCol
if UlCol < 1 then UlCol = 1
if UlCol > 79 then UlCol = 79
if LrCol < 1 then LrCol = 1
if LrCol > 79 then LrCol = 79
if UlRow = LrRow or UlCol = LrCol then TESTWHICH
color fg,bg
locate UlRow,UlCol : ? chr$(201);
for i% = UlCol + 1 to LrCol : ? chr$(205);: next
locate UlRow,LrCol : ? chr$(187);
for i% = UlRow + 1 to LrRow : locate i%,LrCol : ? chr$(186);:next
locate LrRow,LrCol : ? chr$(188);
for i% = LrCol - 1 to UlCol + 1 step -1
locate LrRow,i% : ? chr$(205);:next
locate LrRow,UlCol : ? chr$(200);
for i% = LrRow - 1 to UlRow + 1 step -1
locate i%,UlCol : ? chr$(186);:next
exit sub
TESTWHICH:
if UlRow = LrRow and UlCol <> LrCol then HORIZONTALINE
if UlRow <> LrRow and UlCol = LrCol then VERTICALINE
locate UlRow,UlCol
color fg,bg
? chr$(206);
exit sub
VERTICALINE:
color fg,bg
locate UlRow,UlCol : ? chr$(203);
for i% = UlRow + 1 to LrRow
locate i%,UlCol : ? chr$(186);:next
locate LrRow,LrCol : ? chr$(202);
exit sub
HORIZONTALINE:
color fg,bg
locate UlRow,UlCol : ? chr$(204);
for i% = UlCol + 1 to LrCol - 1
locate UlRow,i% : ? chr$(205);:next
? chr$(185);
end sub
TRAP:
resume MENU